import Common
import Utility.FreeDesktop
-import Utility.FileSystemEncoding
-import Utility.Path
-
-import System.IO
-import Utility.SystemDirectory
installMenu :: String -> OsPath -> OsPath -> OsPath -> IO ()
#ifdef darwin_HOST_OS
import Common
import Utility.FreeDesktop
-import Utility.Exception
{- ~/.config/git-annex/file -}
userConfigFile :: OsPath -> IO OsPath
catFileMetaDataStop = CoProcess.stop . checkFileProcess
{- Reads a file from a specified branch. -}
-catFile :: CatFileHandle -> Branch -> RawFilePath -> IO L.ByteString
+catFile :: CatFileHandle -> Branch -> OsPath -> IO L.ByteString
catFile h branch file = catObject h $
Git.Ref.branchFileRef branch file
-catFileDetails :: CatFileHandle -> Branch -> RawFilePath -> IO (Maybe (L.ByteString, Sha, ObjectType))
+catFileDetails :: CatFileHandle -> Branch -> OsPath -> IO (Maybe (L.ByteString, Sha, ObjectType))
catFileDetails h branch file = catObjectDetails h $
Git.Ref.branchFileRef branch file
import qualified Data.ByteString.Char8 as S8
import qualified Data.List.NonEmpty as NE
import Data.Char
-import qualified System.FilePath.ByteString as P
import Control.Concurrent.Async
import Common
params = addparams ++ explicitrepoparams
++ ["config", "--null", "--list"]
p = (proc "git" params)
- { cwd = Just (fromRawFilePath d)
+ { cwd = Just (fromOsPath d)
, env = gitEnv repo
, std_out = CreatePipe
}
Just (ConfigValue d) -> do
{- core.worktree is relative to the gitdir -}
top <- absPath (gitdir l)
- let p = absPathFrom top d
+ let p = absPathFrom top (toOsPath d)
return $ l { worktree = Just p }
Just NoConfigValue -> return l
return $ r { location = l' }
-- Cannot use gitCommandLine here because specifying --git-dir
-- will bypass the git security check.
let p = (proc "git" ["config", "--local", "--list"])
- { cwd = Just (fromRawFilePath (repoPath r))
+ { cwd = Just (fromOsPath (repoPath r))
, env = gitEnv r
}
(out, ok) <- processTranscript' p Nothing
import Utility.UserInfo
import Utility.Url.Parse
import qualified Utility.RawFilePath as R
-
-import qualified Data.ByteString as B
-import qualified System.FilePath.ByteString as P
+import qualified Utility.OsString as OS
{- Finds the git repository used for the cwd, which may be in a parent
- directory. -}
fromCwd :: IO (Maybe Repo)
-fromCwd = R.getCurrentDirectory >>= seekUp
+fromCwd = R.getCurrentDirectory >>= seekUp . toOsPath
where
seekUp dir = do
r <- checkForRepo dir
Just loc -> pure $ Just $ newFrom loc
{- Local Repo constructor, accepts a relative or absolute path. -}
-fromPath :: RawFilePath -> IO Repo
+fromPath :: OsPath -> IO Repo
fromPath dir
-- When dir == "foo/.git", git looks for "foo/.git/.git",
-- and failing that, uses "foo" as the repository.
- | (P.pathSeparator `B.cons` ".git") `B.isSuffixOf` canondir =
- ifM (doesDirectoryExist $ fromOsPath dir </> ".git")
+ | (pathSeparator `OS.cons` dotgit) `OS.isSuffixOf` canondir =
+ ifM (doesDirectoryExist $ dir </> dotgit)
( ret dir
- , ret (P.takeDirectory canondir)
+ , ret (takeDirectory canondir)
)
- | otherwise = ifM (doesDirectoryExist (fromOsPath dir))
+ | otherwise = ifM (doesDirectoryExist dir)
( checkGitDirFile dir >>= maybe (ret dir) (pure . newFrom)
-- git falls back to dir.git when dir doesn't
-- exist, as long as dir didn't end with a
-- path separator
, if dir == canondir
- then ret (dir <> ".git")
+ then ret (dir <> dotgit)
else ret dir
)
where
+ dotgit = literalOsPath ".git"
ret = pure . newFrom . LocalUnknown
- canondir = P.dropTrailingPathSeparator dir
+ canondir = dropTrailingPathSeparator dir
{- Local Repo constructor, requires an absolute path to the repo be
- specified. -}
-fromAbsPath :: RawFilePath -> IO Repo
+fromAbsPath :: OsPath -> IO Repo
fromAbsPath dir
| absoluteGitPath dir = fromPath dir
| otherwise =
fromUrl' :: String -> IO Repo
fromUrl' url
| "file://" `isPrefixOf` url = case parseURIPortable url of
- Just u -> fromAbsPath $ toRawFilePath $ unEscapeString $ uriPath u
+ Just u -> fromAbsPath $ toOsPath $ unEscapeString $ uriPath u
Nothing -> pure $ newFrom $ UnparseableUrl url
| otherwise = case parseURIPortable url of
Just u -> pure $ newFrom $ Url u
[ s
, "//"
, auth
- , fromRawFilePath (repoPath r)
+ , fromOsPath (repoPath r)
]
in r { location = Url $ fromJust $ parseURIPortable absurl }
_ -> r
fromRemotePath :: FilePath -> Repo -> IO Repo
fromRemotePath dir repo = do
dir' <- expandTilde dir
- fromPath $ repoPath repo P.</> dir'
+ fromPath $ repoPath repo </> dir'
{- Git remotes can have a directory that is specified relative
- to the user's home directory, or that contains tilde expansions.
adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation)
adjustGitDirFile' loc@(Local {}) = do
let gd = gitdir loc
- c <- firstLine <$> catchDefaultIO "" (readFile (fromRawFilePath gd))
+ c <- firstLine <$> catchDefaultIO "" (readFile (fromOsPath gd))
if gitdirprefix `isPrefixOf` c
then do
- top <- fromRawFilePath . P.takeDirectory <$> absPath gd
+ top <- takeDirectory <$> absPath gd
return $ Just $ loc
- { gitdir = absPathFrom
- (toRawFilePath top)
- (toRawFilePath
- (drop (length gitdirprefix) c))
+ { gitdir = absPathFrom top $
+ toOsPath $ drop (length gitdirprefix) c
}
else return Nothing
where
import qualified Git.Config
import Utility.Env
import Utility.Env.Set
-import qualified Utility.RawFilePath as R
import qualified Data.ByteString as B
-import qualified System.FilePath.ByteString as P
{- Gets the current git repository.
-
get :: IO Repo
get = do
gd <- getpathenv "GIT_DIR"
- r <- configure gd =<< fromCwd
+ r <- configure (fmap toOsPath gd) =<< fromCwd
prefix <- getpathenv "GIT_PREFIX"
wt <- maybe (worktree (location r)) Just
<$> getpathenvprefix "GIT_WORK_TREE" prefix
case wt of
Nothing -> relPath r
Just d -> do
- curr <- R.getCurrentDirectory
+ curr <- getCurrentDirectory
unless (d `dirContains` curr) $
setCurrentDirectory d
relPath $ addworktree wt r
getpathenv s >>= \case
Nothing -> return Nothing
Just d
- | d == "." -> return (Just d)
+ | d == "." -> return (Just (toOsPath d))
| otherwise -> Just
- <$> absPath (prefix P.</> d)
- getpathenvprefix s _ = getpathenv s
+ <$> absPath (toOsPath prefix </> toOsPath d)
+ getpathenvprefix s _ = fmap toOsPath <$> getpathenv s
configure Nothing (Just r) = Git.Config.read r
configure (Just d) _ = do
absd <- absPath d
- curr <- R.getCurrentDirectory
+ curr <- getCurrentDirectory
loc <- adjustGitDirFile $ Local
{ gitdir = absd
, worktree = Just curr
parseDiffRaw,
) where
-import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Attoparsec.ByteString.Lazy as A
import qualified Data.Attoparsec.ByteString.Char8 as A8
import Git.DiffTreeItem
import qualified Git.Quote
import qualified Git.Ref
+import qualified Utility.OsString as OS
import Utility.Attoparsec
{- Checks if the DiffTreeItem modifies a file with a given name
isDiffOf :: DiffTreeItem -> TopFilePath -> Bool
isDiffOf diff f =
let f' = getTopFilePath f
- in if B.null f'
+ in if OS.null f'
then True -- top of repo contains all
else f' `dirContains` getTopFilePath (file diff)
<*> (maybe (fail "bad dstsha") return . extractSha =<< nextword)
<* A8.char ' '
<*> A.takeByteString
- <*> pure (asTopFilePath $ fromInternalGitPath $ Git.Quote.unquote f)
+ <*> pure (asTopFilePath $ fromInternalGitPath $ toOsPath $ Git.Quote.unquote f)
where
nextword = A8.takeTill (== ' ')
import System.PosixCompat.Files (fileMode)
#endif
-import qualified System.FilePath.ByteString as P
-
data Hook = Hook
- { hookName :: RawFilePath
+ { hookName :: OsPath
, hookScript :: String
, hookOldScripts :: [String]
}
instance Eq Hook where
a == b = hookName a == hookName b
-hookFile :: Hook -> Repo -> RawFilePath
-hookFile h r = localGitDir r P.</> "hooks" P.</> hookName h
+hookFile :: Hook -> Repo -> OsPath
+hookFile h r = localGitDir r </> literalOsPath "hooks" </> hookName h
{- Writes a hook. Returns False if the hook already exists with a different
- content. Upgrades old scripts.
-- Hook scripts on Windows could use CRLF endings, but
-- they typically use unix newlines, which does work there
-- and makes the repository more portable.
- viaTmp F.writeFile' (toOsPath f) (encodeBS (hookScript h))
- void $ tryIO $ modifyFileMode f (addModes executeModes)
+ viaTmp F.writeFile' f (encodeBS (hookScript h))
+ void $ tryIO $ modifyFileMode (fromOsPath f) (addModes executeModes)
return True
{- Removes a hook. Returns False if the hook contained something else, and
-- and so a hook file that has CRLF will be treated the same as one
-- that has LF. That is intentional, since users may have a reason
-- to prefer one or the other.
- content <- readFile $ fromRawFilePath $ hookFile h r
+ content <- readFile $ fromOsPath $ hookFile h r
return $ if content == hookScript h
then ExpectedContent
else if any (content ==) (hookOldScripts h)
let f = hookFile h r
catchBoolIO $
#ifndef mingw32_HOST_OS
- isExecutable . fileMode <$> R.getFileStatus f
+ isExecutable . fileMode <$> R.getFileStatus (fromOsPath f)
#else
- doesFileExist (fromRawFilePath f)
+ doesFileExist f
#endif
runHook :: (FilePath -> [CommandParam] -> IO a) -> Hook -> [CommandParam] -> Repo -> IO a
runHook runner h ps r = do
- let f = fromRawFilePath $ hookFile h r
+ let f = fromOsPath $ hookFile h r
(c, cps) <- findShellCommand f
runner c (cps ++ ps)
import Utility.Env
import Utility.Env.Set
-import qualified System.FilePath.ByteString as P
-
indexEnv :: String
indexEnv = "GIT_INDEX_FILE"
-
- So, an absolute path is the only safe option for this to return.
-}
-indexEnvVal :: RawFilePath -> IO String
-indexEnvVal p = fromRawFilePath <$> absPath p
+indexEnvVal :: OsPath -> IO String
+indexEnvVal p = fromOsPath <$> absPath p
{- Forces git to use the specified index file.
-
-
- Warning: Not thread safe.
-}
-override :: RawFilePath -> Repo -> IO (IO ())
+override :: OsPath -> Repo -> IO (IO ())
override index _r = do
res <- getEnv var
val <- indexEnvVal index
reset _ = unsetEnv var
{- The normal index file. Does not check GIT_INDEX_FILE. -}
-indexFile :: Repo -> RawFilePath
-indexFile r = localGitDir r P.</> "index"
+indexFile :: Repo -> OsPath
+indexFile r = localGitDir r </> literalOsPath "index"
{- The index file git will currently use, checking GIT_INDEX_FILE. -}
-currentIndexFile :: Repo -> IO RawFilePath
-currentIndexFile r = maybe (indexFile r) toRawFilePath <$> getEnv indexEnv
+currentIndexFile :: Repo -> IO OsPath
+currentIndexFile r = maybe (indexFile r) toOsPath <$> getEnv indexEnv
{- Git locks the index by creating this file. -}
-indexFileLock :: RawFilePath -> RawFilePath
-indexFileLock f = f <> ".lock"
+indexFileLock :: OsPath -> OsPath
+indexFileLock f = f <> literalOsPath ".lock"
-- sha
<*> (Ref <$> A8.takeTill A8.isSpace)
- fileparser = asTopFilePath . Git.Quote.unquote <$> A.takeByteString
+ fileparser = asTopFilePath . toOsPath . Git.Quote.unquote
+ <$> A.takeByteString
sizeparser = fmap Just A8.decimal
[ encodeBS (showOct (mode ti) "")
, typeobj ti
, fromRef' (sha ti)
- ] <> (S.cons (fromIntegral (ord '\t')) (getTopFilePath (file ti)))
+ ]
+ <> (S.cons (fromIntegral (ord '\t'))
+ (fromOsPath (getTopFilePath (file ti))))
import qualified Utility.OsString as OS
import qualified Data.ByteString as B
-import qualified System.FilePath.ByteString as P
+objectsDir :: Repo -> OsPath
+objectsDir r = localGitDir r </> literalOsPath "objects"
-objectsDir :: Repo -> RawFilePath
-objectsDir r = localGitDir r P.</> "objects"
+packDir :: Repo -> OsPath
+packDir r = objectsDir r </> literalOsPath "pack"
-packDir :: Repo -> RawFilePath
-packDir r = objectsDir r P.</> "pack"
+packIdxFile :: OsPath -> OsPath
+packIdxFile = flip replaceExtension (literalOsPath "idx")
-packIdxFile :: RawFilePath -> RawFilePath
-packIdxFile = flip P.replaceExtension "idx"
-
-listPackFiles :: Repo -> IO [RawFilePath]
-listPackFiles r = filter (".pack" `B.isSuffixOf`)
+listPackFiles :: Repo -> IO [OsPath]
+listPackFiles r = filter (literalOsPath ".pack" `OS.isSuffixOf`)
<$> catchDefaultIO [] (dirContents $ packDir r)
listLooseObjectShas :: Repo -> IO [Sha]
listLooseObjectShas r = catchDefaultIO [] $
mapMaybe conv <$> emptyWhenDoesNotExist
- (dirContentsRecursiveSkipping (== "pack") True (objectsDir r))
+ (dirContentsRecursiveSkipping ispackdir True (objectsDir r))
where
conv :: OsPath -> Maybe Sha
conv = extractSha
. take 2
. reverse
. splitDirectories
+ ispackdir f = f == literalOsPath "pack"
looseObjectFile :: Repo -> Sha -> OsPath
-looseObjectFile r sha = objectsDir r P.</> prefix P.</> rest
+looseObjectFile r sha = objectsDir r </> toOsPath prefix </> toOsPath rest
where
(prefix, rest) = B.splitAt 2 (fromRef' sha)
listAlternates :: Repo -> IO [FilePath]
listAlternates r = catchDefaultIO [] $
- lines <$> readFile (fromRawFilePath alternatesfile)
+ lines <$> readFile (fromOsPath alternatesfile)
where
- alternatesfile = objectsDir r P.</> "info" P.</> "alternates"
+ alternatesfile = objectsDir r </> literalOsPath "info" </> literalOsPath "alternates"
{- A repository recently cloned with --shared will have one or more
- alternates listed, and contain no loose objects or packs. -}
instance Quoteable StringContainingQuotedPath where
quote _ (UnquotedString s) = safeOutput (encodeBS s)
quote _ (UnquotedByteString s) = safeOutput s
- quote qp (QuotedPath p) = quote qp p
+ quote qp (QuotedPath p) = quote qp (fromOsPath p :: RawFilePath)
quote qp (a :+: b) = quote qp a <> quote qp b
noquote (UnquotedString s) = encodeBS s
noquote (UnquotedByteString s) = s
- noquote (QuotedPath p) = p
+ noquote (QuotedPath p) = fromOsPath p
noquote (a :+: b) = noquote a <> noquote b
instance IsString StringContainingQuotedPath where
-- limits what's tested to ascii, so avoids running into it.
prop_quote_unquote_roundtrip :: TestableFilePath -> Bool
prop_quote_unquote_roundtrip ts =
- s == fromOsPath (unquote (quoteAlways (toOsPath s)))
+ s == fromRawFilePath (unquote (quoteAlways (toRawFilePath s)))
where
s = fromTestableFilePath ts
import Data.Char (chr, ord)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
-import qualified System.FilePath.ByteString as P
headRef :: Ref
headRef = Ref "HEAD"
-headFile :: Repo -> RawFilePath
-headFile r = localGitDir r P.</> "HEAD"
+headFile :: Repo -> OsPath
+headFile r = localGitDir r </> literalOsPath "HEAD"
setHeadRef :: Ref -> Repo -> IO ()
setHeadRef ref r =
- F.writeFile' (toOsPath (headFile r)) ("ref: " <> fromRef' ref)
+ F.writeFile' (headFile r) ("ref: " <> fromRef' ref)
{- Converts a fully qualified git ref into a user-visible string. -}
describe :: Ref -> String
-
- If the input file is located outside the repository, returns Nothing.
-}
-fileRef :: RawFilePath -> Repo -> IO (Maybe Ref)
+fileRef :: OsPath -> Repo -> IO (Maybe Ref)
fileRef f repo = do
-- The filename could be absolute, or contain eg "../repo/file",
-- neither of which work in a ref, so convert it to a minimal
-- Prefixing the file with ./ makes this work even when in a
-- subdirectory of a repo. Eg, ./foo in directory bar refers
-- to bar/foo, not to foo in the top of the repository.
- then Just $ Ref $ ":./" <> toInternalGitPath f'
+ then Just $ Ref $ ":./" <> fromOsPath (toInternalGitPath f')
else Nothing
{- A Ref that can be used to refer to a file in a particular branch. -}
-branchFileRef :: Branch -> RawFilePath -> Ref
-branchFileRef branch f = Ref $ fromRef' branch <> ":" <> toInternalGitPath f
+branchFileRef :: Branch -> OsPath -> Ref
+branchFileRef branch f = Ref $ fromOsPath $
+ toOsPath (fromRef' branch) <> literalOsPath ":" <> toInternalGitPath f
{- Converts a Ref to refer to the content of the Ref on a given date. -}
dateRef :: Ref -> RefDate -> Ref
-
- If the file path is located outside the repository, returns Nothing.
-}
-fileFromRef :: Ref -> RawFilePath -> Repo -> IO (Maybe Ref)
+fileFromRef :: Ref -> OsPath -> Repo -> IO (Maybe Ref)
fileFromRef r f repo = fileRef f repo >>= return . \case
Just (Ref fr) -> Just (Ref (fromRef' r <> fr))
Nothing -> Nothing
explodePacks r = go =<< listPackFiles r
where
go [] = return False
- go packs = withTmpDir (toOsPath "packs") $ \tmpdir -> do
- r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" tmpdir
+ go packs = withTmpDir (literalOsPath "packs") $ \tmpdir -> do
+ r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" (fromOsPath tmpdir)
putStrLn "Unpacking all pack files."
forM_ packs $ \packfile -> do
-- Just in case permissions are messed up.
void $ tryIO $
pipeWrite [Param "unpack-objects", Param "-r"] r' $ \h ->
L.hPut h =<< F.readFile (toOsPath packfile)
- objs <- emptyWhenDoesNotExist (dirContentsRecursive (toRawFilePath tmpdir))
+ objs <- emptyWhenDoesNotExist (dirContentsRecursive tmpdir)
forM_ objs $ \objfile -> do
- f <- relPathDirToFile
- (toRawFilePath tmpdir)
- objfile
+ f <- relPathDirToFile tmpdir objfile
let dest = objectsDir r P.</> f
- createDirectoryIfMissing True
- (fromRawFilePath (parentDir dest))
+ createDirectoryIfMissing True (parentDir dest)
moveFile objfile dest
forM_ packs $ \packfile -> do
removeWhenExistsWith R.removeLink packfile
retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResults
retrieveMissingObjects missing referencerepo r
| not (foundBroken missing) = return missing
- | otherwise = withTmpDir (toOsPath "tmprepo") $ \tmpdir -> do
- unlessM (boolSystem "git" [Param "init", File tmpdir]) $
- giveup $ "failed to create temp repository in " ++ tmpdir
- tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir)
- let repoconfig r' = toOsPath (localGitDir r' P.</> "config")
- whenM (doesFileExist (fromRawFilePath (fromOsPath (repoconfig r)))) $
+ | otherwise = withTmpDir (literalOsPath "tmprepo") $ \tmpdir -> do
+ unlessM (boolSystem "git" [Param "init", File (fromOsPath tmpdir)]) $
+ giveup $ "failed to create temp repository in " ++ fromOsPath tmpdir
+ tmpr <- Config.read =<< Construct.fromPath tmpdir
+ let repoconfig r' = localGitDir r' </> "config"
+ whenM (doesFileExist (repoconfig r)) $
F.readFile (repoconfig r) >>= F.writeFile (repoconfig tmpr)
rs <- Construct.fromRemotes r
stillmissing <- pullremotes tmpr rs fetchrefstags missing
copyObjects :: Repo -> Repo -> IO Bool
copyObjects srcr destr = rsync
[ Param "-qr"
- , File $ addTrailingPathSeparator $ fromRawFilePath $ objectsDir srcr
- , File $ addTrailingPathSeparator $ fromRawFilePath $ objectsDir destr
+ , File $ fromOsPath $ addTrailingPathSeparator $ objectsDir srcr
+ , File $ fromOsPath $ addTrailingPathSeparator $ objectsDir destr
]
{- To deal with missing objects that cannot be recovered, resets any
- Relies on packed refs being exploded before it's called.
-}
getAllRefs :: Repo -> IO [Ref]
-getAllRefs r = getAllRefs' (localGitDir r P.</> "refs")
+getAllRefs r = getAllRefs' (localGitDir r </> literalOsPath "refs")
-getAllRefs' :: RawFilePath -> IO [Ref]
+getAllRefs' :: OsPath -> IO [Ref]
getAllRefs' refdir = do
- let topsegs = length (P.splitPath refdir) - 1
- let toref = Ref . toInternalGitPath . encodeBS
+ let topsegs = length (splitPath refdir) - 1
+ let toref = Ref . toInternalGitPath
. joinPath . drop topsegs . splitPath
- . decodeBS
map toref <$> emptyWhenDoesNotExist (dirContentsRecursive refdir)
explodePackedRefsFile :: Repo -> IO ()
explodePackedRefsFile r = do
let f = packedRefsFile r
- let f' = toRawFilePath f
whenM (doesFileExist f) $ do
rs <- mapMaybe parsePacked
. map decodeBS
. fileLines'
- <$> catchDefaultIO "" (safeReadFile f')
+ <$> catchDefaultIO "" (safeReadFile f)
forM_ rs makeref
- removeWhenExistsWith R.removeLink f'
+ removeWhenExistsWith R.removeLink (fromOsPath f)
where
makeref (sha, ref) = do
let gitd = localGitDir r
- let dest = gitd P.</> fromRef' ref
- let dest' = fromRawFilePath dest
+ let dest = gitd </> toOsPath (fromRef' ref)
createDirectoryUnder [gitd] (parentDir dest)
- unlessM (doesFileExist dest') $
- writeFile dest' (fromRef sha)
+ unlessM (doesFileExist dest) $
+ writeFile (fromOsPath dest) (fromRef sha)
-packedRefsFile :: Repo -> FilePath
-packedRefsFile r = fromRawFilePath (localGitDir r) </> "packed-refs"
+packedRefsFile :: Repo -> OsPath
+packedRefsFile r = localGitDir r </> "packed-refs"
parsePacked :: String -> Maybe (Sha, Ref)
parsePacked l = case words l of
length indexcontents `seq` cleanup
missingIndex :: Repo -> IO Bool
-missingIndex r = not <$> doesFileExist (fromRawFilePath (localGitDir r) </> "index")
+missingIndex r = not <$> doesFileExist (localGitDir r </> "index")
{- Finds missing and ok files staged in the index. -}
partitionIndex :: Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool)
successfulRepair :: (Bool, [Branch]) -> Bool
successfulRepair = fst
-safeReadFile :: RawFilePath -> IO B.ByteString
+safeReadFile :: OsPath -> IO B.ByteString
safeReadFile f = do
- allowRead f
- F.readFile' (toOsPath f)
+ allowRead (fromOsPath f)
+ F.readFile' f
in go (v : c) xs'
_ -> go c xs
- cparse 'M' f _ = (Just (Modified (asTopFilePath (toRawFilePath f))), Nothing)
- cparse 'A' f _ = (Just (Added (asTopFilePath (toRawFilePath f))), Nothing)
- cparse 'D' f _ = (Just (Deleted (asTopFilePath (toRawFilePath f))), Nothing)
- cparse 'T' f _ = (Just (TypeChanged (asTopFilePath (toRawFilePath f))), Nothing)
- cparse '?' f _ = (Just (Untracked (asTopFilePath (toRawFilePath f))), Nothing)
+ cparse 'M' f _ = (Just (Modified (asTopFilePath (toOsPath f))), Nothing)
+ cparse 'A' f _ = (Just (Added (asTopFilePath (toOsPath f))), Nothing)
+ cparse 'D' f _ = (Just (Deleted (asTopFilePath (toOsPath f))), Nothing)
+ cparse 'T' f _ = (Just (TypeChanged (asTopFilePath (toOsPath f))), Nothing)
+ cparse '?' f _ = (Just (Untracked (asTopFilePath (toOsPath f))), Nothing)
cparse 'R' f (oldf:xs) =
- (Just (Renamed (asTopFilePath (toRawFilePath oldf)) (asTopFilePath (toRawFilePath f))), Just xs)
+ (Just (Renamed (asTopFilePath (toOsPath oldf)) (asTopFilePath (toOsPath f))), Just xs)
cparse _ _ _ = (Nothing, Nothing)
getStatus :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedUnstaged Status], IO Bool)
Just (NewSubTree d l) ->
go (addsubtree idir m (NewSubTree d (c:l))) is
_ ->
- go (addsubtree idir m (NewSubTree (asTopFilePath idir) [c])) is
+ go (addsubtree idir m (NewSubTree (asTopFilePath (toOsPath idir)) [c])) is
where
p = gitPath i
idir = P.takeDirectory p
Just (NewSubTree d' l) ->
let l' = filter (\ti -> gitPath ti /= d) l
in addsubtree parent m' (NewSubTree d' (t:l'))
- _ -> addsubtree parent m' (NewSubTree (asTopFilePath parent) [t])
+ _ -> addsubtree parent m' (NewSubTree (asTopFilePath (toOsPath parent)) [t])
| otherwise = M.insert d t m
where
parent = P.takeDirectory d
subdirs = P.splitDirectories $ gitPath graftloc
- graftdirs = map (asTopFilePath . toInternalGitPath) $
+ graftdirs = map (asTopFilePath . toInternalGitPath . toOsPath) $
pathPrefixes subdirs
{- Assumes the list is ordered, with tree objects coming right before their
gitPath = toRawFilePath
instance GitPath TopFilePath where
- gitPath = getTopFilePath
+ gitPath = fromOsPath . getTopFilePath
instance GitPath TreeItem where
gitPath (TreeItem f _ _) = gitPath f
<> " blob "
<> fromRef' sha
<> "\t"
- <> indexPath file
+ <> fromOsPath (indexPath file)
-stageFile :: Sha -> TreeItemType -> RawFilePath -> Repo -> IO Streamer
+stageFile :: Sha -> TreeItemType -> OsPath -> Repo -> IO Streamer
stageFile sha treeitemtype file repo = do
p <- toTopFilePath file repo
return $ pureStreamer $ updateIndexLine sha treeitemtype p
{- A streamer that removes a file from the index. -}
-unstageFile :: RawFilePath -> Repo -> IO Streamer
+unstageFile :: OsPath -> Repo -> IO Streamer
unstageFile file repo = do
p <- toTopFilePath file repo
return $ unstageFile' p
"0 "
<> fromRef' deleteSha
<> "\t"
- <> indexPath p
+ <> fromOsPath (indexPath p)
{- A streamer that adds a symlink to the index. -}
-stageSymlink :: RawFilePath -> Sha -> Repo -> IO Streamer
+stageSymlink :: OsPath -> Sha -> Repo -> IO Streamer
stageSymlink file sha repo = do
!line <- updateIndexLine
<$> pure sha
- update-index. Sending Nothing will wait for update-index to finish
- updating the index.
-}
-refreshIndex :: (MonadIO m, MonadMask m) => Repo -> ((Maybe RawFilePath -> IO ()) -> m ()) -> m ()
+refreshIndex :: (MonadIO m, MonadMask m) => Repo -> ((Maybe OsPath -> IO ()) -> m ()) -> m ()
refreshIndex repo feeder = bracket
(liftIO $ createProcess p)
(liftIO . cleanupProcess)
hClose h
forceSuccessProcess p pid
feeder $ \case
- Just f -> S.hPut h (S.snoc f 0)
+ Just f -> S.hPut h (S.snoc (fromOsPath f) 0)
Nothing -> closer
liftIO $ closer
go _ = error "internal"
import System.PosixCompat.Files (isDirectory, isSymbolicLink)
import Control.Applicative
import System.IO.Unsafe (unsafeInterleaveIO)
-import qualified System.FilePath.ByteString as P
import Data.Maybe
import Prelude
import Utility.Directory
import Utility.Exception
import Utility.FileSystemEncoding
+import Utility.OsPath
#ifndef mingw32_HOST_OS
data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream
case v of
Nothing -> return False
Just f
- | not (dirCruft f) -> return True
+ | not (toOsPath f `elem` dirCruft) -> return True
| otherwise -> check h
) where
import Common
-import Utility.Exception
import Utility.UserInfo
-import Utility.Process
import System.Environment
-import Data.List
-import Data.Maybe
-import Control.Applicative
-import Prelude
type DesktopEntry = [(Key, Value)]
fromOsPath,
module X,
getSearchPath,
+ unsafeFromChar
) where
import Utility.FileSystemEncoding
+import Data.ByteString.Short (ShortByteString)
+import qualified Data.ByteString.Short as S
#ifdef WITH_OSPATH
-import System.OsPath as X hiding (OsPath, OsString)
+import System.OsPath as X hiding (OsPath, OsString, unsafeFromChar)
import System.OsPath
import "os-string" System.OsString.Internal.Types
-import qualified Data.ByteString.Short as S
import qualified System.FilePath.ByteString as PB
#else
import System.FilePath.ByteString as X hiding (RawFilePath, getSearchPath)
import System.FilePath.ByteString (getSearchPath)
-import qualified Data.ByteString as S
+import Data.ByteString (ByteString)
+import Data.Char
+import Data.Word
#endif
class OsPathConv t where
#ifdef WITH_OSPATH
instance OsPathConv RawFilePath where
+ toOsPath = bytesToOsPath . S.toShort
+ fromOsPath = S.fromShort . bytesFromOsPath
+
+instance OsPathConv ShortByteString where
toOsPath = bytesToOsPath
fromOsPath = bytesFromOsPath
{- Unlike System.OsString.fromBytes, on Windows this does not ensure a
- valid USC-2LE encoding. The input ByteString must be in a valid encoding
- already or uses of the OsPath will fail. -}
-bytesToOsPath :: RawFilePath -> OsPath
+bytesToOsPath :: ShortByteString -> OsPath
#if defined(mingw32_HOST_OS)
-bytesToOsPath = OsString . WindowsString . S.toShort
+bytesToOsPath = OsString . WindowsString
#else
-bytesToOsPath = OsString . PosixString . S.toShort
+bytesToOsPath = OsString . PosixString
#endif
-bytesFromOsPath :: OsPath -> RawFilePath
+bytesFromOsPath :: OsPath -> ShortByteString
#if defined(mingw32_HOST_OS)
-bytesFromOsPath = S.fromShort . getWindowsString . getOsString
+bytesFromOsPath = getWindowsString . getOsString
#else
-bytesFromOsPath = S.fromShort . getPosixString . getOsString
+bytesFromOsPath = getPosixString . getOsString
#endif
{- For some reason not included in System.OsPath -}
-}
type OsPath = RawFilePath
-type OsString = S.ByteString
+type OsString = ByteString
instance OsPathConv RawFilePath where
toOsPath = id
fromOsPath = id
+
+instance OsPathConv ShortByteString where
+ toOsPath = S.fromShort
+ fromOsPath = S.toShort
+
+unsafeFromChar :: Char -> Word8
+unsafeFromChar = fromIntegral . ord
#endif
) where
import Utility.Path
+import Utility.OsPath
import Utility.FileSystemEncoding
-import System.FilePath.ByteString (combine)
import qualified Data.ByteString as B
import qualified System.FilePath.Windows.ByteString as P
import System.Directory (getCurrentDirectory)
-- Make absolute because any '.' and '..' in the path
-- will not be resolved once it's converted.
cwd <- toRawFilePath <$> getCurrentDirectory
- let p = simplifyPath (combine cwd f)
+ let p = fromOsPath (simplifyPath (toOsPath (combine cwd f)))
-- Normalize slashes.
let p' = P.normalise p
return (win32_file_namespace <> p')
withTmpFile (toOsPath "sop") $ \tmpfile h -> do
liftIO $ B.hPutStr h password
liftIO $ hClose h
- let passwordfile = [Param $ "--with-password=" ++ fromRawFilePath (fromOsPath tmpfile)]
+ let passwordfile = [Param $ "--with-password=" ++ fromOsPath tmpfile]
-- Don't need to pass emptydirectory since @FD is not used,
-- and so tmpfile also does not need to be made absolute.
case emptydirectory of
projects / git-annex.git / commitdiff